home *** CD-ROM | disk | FTP | other *** search
/ United Public Domain Gold 2 / United Public Domain Gold 2.iso / utilities / pu453.dms / pu453.adf / extras / basic_sources / checkers2.3.bas < prev    next >
BASIC Source File  |  1992-11-08  |  28KB  |  1,412 lines
  1. REM ------- Checkers v2.3 ** ATTACKER ** ------------
  2. REM $option Y+,K200
  3. RANDOMIZE TIMER
  4.  
  5. SCREEN 1,640,512,2,4
  6. WINDOW 1,"",(0,0)-(600,480),0,1
  7. PALETTE 0,0,0,0
  8. PALETTE 1,.7,.7,.7
  9. PALETTE 2,1,0,0
  10. PALETTE 3,0,0,1
  11. sxs = 1 : sxe = 600
  12. sys = 1 : sye = 380
  13. eatf = 0
  14.  
  15. DIM a(8,8)
  16. DIM a2(8,8)
  17.  
  18. setpieces a()
  19.  
  20. WHILE MOUSE(0)=0
  21.     update a(),sxs,sys,sxe,sye
  22.     play a(),-1,a2()
  23.     makekings a(),0
  24.     update a(),sxs,sys,sxe,sye
  25.     play2 a(),1,a2()
  26.     makekings a(),0
  27. WEND
  28.  
  29. WHILE MOUSE(0) = 0 : WEND
  30. SYSTEM
  31.  
  32. SUB play(a(),col,n()) STATIC
  33.     SHARED sxs,sys,sxe,sye,eatf
  34.     DIM movelist(600,3) : REM 1 : Start Square  2 : Dest Square  3 : Points
  35.     mlp = 0 : REM MoveListPointer (Reset)
  36.  
  37.     FOR xp = 1 TO 8
  38.         FOR yp = 1 TO 8
  39.             checksquare xp,yp,a
  40.             IF a THEN
  41.                 p = a(xp,yp)
  42.                 IF p<>0 THEN 
  43.                     pf= p/ABS(p)
  44.                 ELSE
  45.                     pf= 0
  46.                 END IF
  47.                 IF pf = col THEN
  48.                     INCR mlp
  49.                     movelist(mlp,1) = xp + ((yp-1)*8)
  50.                 END IF
  51.             END IF
  52.         NEXT yp
  53.     NEXT xp
  54.  
  55.     REM ----------------------------------- Get First Move
  56.     bflg = 0
  57.     LOCATE 57,1:PRINT "----------------------------------------------------------------------":scrlmsg
  58.     FOR xk1 = 1 TO mlp
  59.  
  60.         ps = movelist(xk1,1)
  61.         yp = INT((ps-1)/8)
  62.         xp = ps-(yp*8)
  63.         INCR yp
  64.  
  65.         flg1 = 0        
  66.         getmoves a(),xp,yp,xn,yn,flg1
  67.     
  68.         IF flg1 > bflg THEN
  69.             bflg = flg1
  70.             sx = xp
  71.             sy = yp
  72.             dx = xn
  73.             dy = yn
  74.             LOCATE 57,1:PRINT "CHK1",sx,sy,dx,dy :scrlmsg
  75.             unsafe = -1
  76.         END IF
  77.         IF flg1 >= bflg AND NOT(eatf) AND unsafe = -1
  78.             bflg = flg1
  79.             sx = xp
  80.             sy = yp
  81.             dx = xn
  82.             dy = yn
  83.             unsafe = 0
  84.             LOCATE 57,1:PRINT "SAFE",sx,sy,dx,dy :scrlmsg
  85.         END IF
  86.         IF flg1 = bflg AND (RND>0.7) AND NOT(eatf) THEN
  87.             bflg = flg1
  88.             sx = xp
  89.             sy = yp
  90.             dx = xn
  91.             dy = yn
  92.             unsafe = 0
  93.             LOCATE 57,1:PRINT "RAND",sx,sy,dx,dy :scrlmsg
  94.         END IF
  95.         
  96.     NEXT xk1    
  97.     
  98.     REM ------------------------------------ Execute the Move
  99.     FOR x = 1 TO 8
  100.         FOR y = 1 TO 8
  101.             n(x,y) = a(x,y)
  102.         NEXT y
  103.     NEXT x
  104.  
  105.     PALETTE 0,0,0,0
  106.     IF bflg = 0 THEN 
  107.         PALETTE 0,0,0,1
  108.     END IF
  109.     IF bflg < 0 THEN
  110.         PALETTE 0,1,0,0
  111.     END IF
  112.     
  113.     IF bflg > 0 THEN
  114.         mark sx,sy,sxs,sys,sxe,sye
  115.         mark dx,dy,sxs,sys,sxe,sye
  116.         SWAP n(sx,sy),n(dx,dy)        
  117.     END IF
  118.     IF bflg = 2 THEN
  119.         kx = ((dx-sx)/2)+sx        
  120.         ky = ((dy-sy)/2)+sy
  121.         n(kx,ky) = 0
  122.     END IF
  123.  
  124.     REM ------------------------------------- Second Eat Move    
  125.     IF bflg = 2 THEN
  126.         nxtmove:
  127.         flg1 = 1
  128.         getmoves n(),dx,dy,nx,ny,flg1
  129.         IF flg1 = 2 THEN
  130.             mark nx,ny,sxs,sys,sxe,sye
  131.             SWAP n(nx,ny),n(dx,dy)        
  132.             kx = ((nx-dx)/2)+dx        
  133.             ky = ((ny-dy)/2)+dy
  134.             n(kx,ky) = 0
  135.             dx = nx : dy = ny
  136.             GOTO nxtmove
  137.         END IF
  138.     END IF
  139.  
  140.     FOR x = 1 TO 8
  141.         FOR y = 1 TO 8
  142.             a(x,y) = n(x,y)
  143.         NEXT y
  144.     NEXT x
  145.         
  146.     ERASE movelist
  147. END SUB
  148.  
  149. REM --------------------------------- TEST LOOKAHEAD
  150.  
  151. SUB test(a(),col,n()) STATIC
  152.     SHARED sxs,sys,sxe,sye
  153.     DIM movelist2(600,3) : REM 1 : Start Square  2 : Dest Square  3 : Points
  154.     mlp2 = 0 : REM movelist2Pointer (Reset)
  155.  
  156.     FOR xp = 1 TO 8
  157.         FOR yp = 1 TO 8
  158.             checksquare xp,yp,a
  159.             IF a THEN
  160.                 p = a(xp,yp)
  161.                 IF p<>0 THEN 
  162.                     pf= p/ABS(p)
  163.                 ELSE
  164.                     pf= 0
  165.                 END IF
  166.                 IF pf = col THEN
  167.                     INCR mlp2
  168.                     movelist2(mlp2,1) = xp + ((yp-1)*8)
  169.                 END IF
  170.             END IF
  171.         NEXT yp
  172.     NEXT xp
  173.  
  174.     REM ----------------------------------- Get First Move
  175.     bflt = 0
  176.     FOR xk1 = 1 TO mlp2
  177.  
  178.         ps = movelist2(xk1,1)
  179.         yp = INT((ps-1)/8)
  180.         xp = ps-(yp*8)
  181.         INCR yp
  182.  
  183.         flg1 = 0        
  184.         getmoves a(),xp,yp,xn,yn,flg1
  185.     
  186.         IF flg1 > bflt THEN
  187.             bflt = flg1
  188.             sx = xp
  189.             sy = yp
  190.             dx = xn
  191.             dy = yn
  192.         END IF
  193.         
  194.     NEXT xk1    
  195.     
  196.     REM ------------------------------------ Execute the Move
  197.     FOR x = 1 TO 8
  198.         FOR y = 1 TO 8
  199.             n(x,y) = a(x,y)
  200.         NEXT y
  201.     NEXT x
  202.  
  203.     PALETTE 0,0,0,0
  204.     IF bflt = 0 THEN 
  205.         PALETTE 0,0,0,1
  206.     END IF
  207.     IF bflt < 0 THEN
  208.         PALETTE 0,1,0,0
  209.     END IF
  210.     
  211.     IF bflt > 0 THEN
  212.         mark sx,sy,sxs,sys,sxe,sye
  213.         mark dx,dy,sxs,sys,sxe,sye
  214.         SWAP n(sx,sy),n(dx,dy)        
  215.     END IF
  216.     IF bflt = 2 THEN
  217.         kx = ((dx-sx)/2)+sx        
  218.         ky = ((dy-sy)/2)+sy
  219.         n(kx,ky) = 0
  220.     END IF
  221.  
  222.     REM ------------------------------------- Second Eat Move    
  223.     IF bflt = 2 THEN
  224.         nxtmove2:
  225.         flg1 = 1
  226.         getmoves n(),dx,dy,nx,ny,flg1
  227.         IF flg1 = 2 THEN
  228.             mark nx,ny,sxs,sys,sxe,sye
  229.             SWAP n(nx,ny),n(dx,dy)        
  230.             kx = ((nx-dx)/2)+dx        
  231.             ky = ((ny-dy)/2)+dy
  232.             n(kx,ky) = 0
  233.             dx = nx : dy = ny
  234.             GOTO nxtmove2
  235.         END IF
  236.     END IF
  237.  
  238. '    FOR x = 1 TO 8
  239. '        FOR y = 1 TO 8
  240. '            a(x,y) = n(x,y)
  241. '        NEXT y
  242. '    NEXT x
  243.         
  244.     ERASE movelist2
  245. END SUB
  246.  
  247.  
  248. SUB makekings(a(),flag) STATIC
  249.     FOR x = 1 TO 8
  250.         p1 = a(x,1)
  251.         p2 = a(x,8)
  252.         IF flag AND p1=1 THEN a(x,1) = 2
  253.         IF NOT(flag) AND p1=-1 THEN a(x,1) = -2
  254.         IF flag AND p2=-1 THEN a(x,8) = -2
  255.         IF NOT(flag) AND p2=1 THEN a(x,8) = 2
  256.     NEXT x
  257. END SUB                
  258.     
  259. SUB getmoves(a(),x,y,x1,y1,flags) STATIC
  260.     REM -- FLAGS = 1 on Entry := Non-Eat moves discarded
  261.     
  262.     LOCAL ur,dr,ul,dl,p
  263.     LOCAL urp,drp,ulp,dlp
  264.     SHARED eatf
  265.     ur = -1 : dr = -1 : ul = -1 : dl = -1 : REM UpRight ...
  266.     p = a(x,y)
  267.     
  268.     REM ------------------------- Eliminate Non-King Non-Moves
  269.     IF ABS(p) = 1 THEN
  270.         IF p = 1 THEN ur = 0 : ul = 0
  271.         IF p = -1 THEN dr= 0 : dl = 0
  272.     END IF 
  273.     
  274.     REM ------------------------- Board Edge Check
  275.     IF x = 8 THEN ur = 0 : dr = 0
  276.     IF x = 1 THEN ul = 0 : dl = 0
  277.     IF y = 8 THEN dr = 0 : dl = 0
  278.     IF y = 1 THEN ur = 0 : ul = 0    
  279.  
  280.     REM ------------------------- Check if friendly pieces in way    
  281.     IF ur THEN p = a(x+1,y-1) : IF p/a(x,y) > 0 THEN ur = 0
  282.     IF ul THEN p = a(x-1,y-1) : IF p/a(x,y) > 0 THEN ul = 0
  283.     IF dr THEN p = a(x+1,y+1) : IF p/a(x,y) > 0 THEN dr = 0
  284.     IF dl THEN p = a(x-1,y+1) : IF p/a(x,y) > 0 THEN dl = 0
  285.         
  286.     REM -------------------------- Eliminate non-eat moves
  287.     IF flags = 1 THEN
  288.         IF ur THEN p = a(x+1,y-1) : IF p = 0 THEN ur = 0
  289.         IF ul THEN p = a(x-1,y-1) : IF p = 0 THEN ul = 0
  290.         IF dr THEN p = a(x+1,y+1) : IF p = 0 THEN dr = 0
  291.         IF dl THEN p = a(x-1,y+1) : IF p = 0 THEN dl = 0
  292.     END IF
  293.  
  294.     REM -------------------------- Initialise Move Pointers
  295.     urp = 0 : ulp = 0 : drp = 0 : dlp = 0
  296.     
  297.     REM -------------------------- Check if step-moves are possible
  298.     IF ur THEN p = a(x+1,y-1) : IF p = 0 THEN urp = 1 : ur = 0
  299.     IF ul THEN p = a(x-1,y-1) : IF p = 0 THEN ulp = 1 : ul = 0
  300.     IF dr THEN p = a(x+1,y+1) : IF p = 0 THEN drp = 1 : dr = 0
  301.     IF dl THEN p = a(x-1,y+1) : IF p = 0 THEN dlp = 1 : dl = 0
  302.  
  303.     REM -------------------------- Select Best step-Move ..
  304.     IF testing THEN GOTO skipTEST
  305.     testing = -1
  306.     DIM tar(8,8),tar2(8,8),tar3(8,8),tar4(8,8)
  307.     FOR xt = 1 TO 8 : FOR yt = 1 TO 8
  308.         tar(xt,yt) = a(xt,yt)
  309.     NEXT yt : NEXT xt
  310.         
  311.     cl = a(x,y)/ABS(a(x,y))
  312.     ncl = 0
  313.     FOR xt = 1 TO 8
  314.         FOR yt = 1 TO 8
  315.             ncl = ncl + a(xt,yt)
  316.         NEXT yt
  317.     NEXT xt
  318.     ncl = ncl * cl
  319.     ldiff = -100
  320.  
  321.     IF urp = 1 THEN
  322.         cl = a(x,y)/ABS(a(x,y))
  323.         cl = cl * -1
  324.         SWAP tar(x,y),tar(x+1,y-1) 
  325.         test tar(),cl,tar4()
  326.         makekings tar4(),0
  327.         nclt = 0
  328.         FOR xt = 1 TO 8
  329.             FOR yt = 1 TO 8
  330.                 nclt = nclt + tar4(xt,yt)
  331.             NEXT yt
  332.         NEXT xt
  333.         nclt = nclt * (-cl)                
  334.         diff = nclt-ncl
  335.  
  336.         IF diff => 0 THEN
  337.         test tar4(),-cl,tar3()
  338.         test tar3(),cl,tar2()
  339.         makekings tar2(),0
  340.                 
  341.         nclt = 0
  342.         FOR xt = 1 TO 8
  343.             FOR yt = 1 TO 8
  344.                 nclt = nclt + tar2(xt,yt)
  345.             NEXT yt
  346.         NEXT xt
  347.         nclt = nclt * (-cl)                
  348.         diff = nclt-ncl
  349.         END IF
  350.         
  351.         IF diff>ldiff THEN ldiff=diff
  352.     END IF
  353.  
  354.     FOR xt = 1 TO 8 : FOR yt = 1 TO 8
  355.         tar(xt,yt) = a(xt,yt)
  356.     NEXT yt : NEXT xt
  357.     IF ulp = 1 THEN
  358.         cl = a(x,y)/ABS(a(x,y))
  359.         cl = cl * -1
  360.         SWAP tar(x,y),tar(x-1,y-1) 
  361.         test tar(),cl,tar4()
  362.         makekings tar4(),0
  363.         nclt = 0
  364.         FOR xt = 1 TO 8
  365.             FOR yt = 1 TO 8
  366.                 nclt = nclt + tar4(xt,yt)
  367.             NEXT yt
  368.         NEXT xt
  369.         nclt = nclt * (-cl)                
  370.         diff = nclt-ncl
  371.  
  372.         IF diff => 0 THEN
  373.         test tar4(),-cl,tar3()
  374.         test tar3(),cl,tar2()
  375.         makekings tar2(),0
  376.  
  377.         nclt = 0
  378.         FOR xt = 1 TO 8
  379.             FOR yt = 1 TO 8
  380.                 nclt = nclt + tar2(xt,yt)
  381.             NEXT yt
  382.         NEXT xt
  383.         nclt = nclt * (-cl)                
  384.         diff = nclt-ncl
  385.         END IF
  386.         IF diff>ldiff THEN 
  387.             ldiff=diff 
  388.             urp = 0
  389.         ELSE 
  390.             ulp = 0
  391.         END IF
  392.     END IF
  393.  
  394.     FOR xt = 1 TO 8 : FOR yt = 1 TO 8
  395.         tar(xt,yt) = a(xt,yt)
  396.     NEXT yt : NEXT xt
  397.     IF drp = 1 THEN
  398.         cl = a(x,y)/ABS(a(x,y))
  399.         cl = cl * -1
  400.         SWAP tar(x,y),tar(x+1,y+1) 
  401.         test tar(),cl,tar4()
  402.         makekings tar4(),0
  403.         nclt = 0
  404.         FOR xt = 1 TO 8
  405.             FOR yt = 1 TO 8
  406.                 nclt = nclt + tar4(xt,yt)
  407.             NEXT yt
  408.         NEXT xt
  409.         nclt = nclt * (-cl)                
  410.         diff = nclt-ncl
  411.  
  412.         IF diff => 0 THEN
  413.         test tar4(),-cl,tar3()
  414.         test tar3(),cl,tar2()
  415.         makekings tar2(),0
  416.  
  417.         nclt = 0
  418.         FOR xt = 1 TO 8
  419.             FOR yt = 1 TO 8
  420.                 nclt = nclt + tar2(xt,yt)
  421.             NEXT yt
  422.         NEXT xt
  423.         nclt = nclt * (-cl)                
  424.         diff = nclt-ncl
  425.         END IF
  426.  
  427.         IF diff>ldiff THEN 
  428.             ldiff=diff 
  429.             urp = 0
  430.             ulp = 0
  431.         ELSE 
  432.             drp = 0
  433.         END IF
  434.     END IF
  435.  
  436.     FOR xt = 1 TO 8 : FOR yt = 1 TO 8
  437.         tar(xt,yt) = a(xt,yt)
  438.     NEXT yt : NEXT xt
  439.     IF dlp = 1 THEN
  440.         cl = a(x,y)/ABS(a(x,y))
  441.         cl = cl * -1
  442.         SWAP tar(x,y),tar(x-1,y+1) 
  443.         test tar(),cl,tar4()
  444.         makekings tar4(),0
  445.         nclt = 0
  446.         FOR xt = 1 TO 8
  447.             FOR yt = 1 TO 8
  448.                 nclt = nclt + tar4(xt,yt)
  449.             NEXT yt
  450.         NEXT xt
  451.         nclt = nclt * (-cl)                
  452.         diff = nclt-ncl
  453.  
  454.         IF diff => 0 THEN
  455.         test tar4(),-cl,tar3()
  456.         test tar3(),cl,tar2()
  457.         makekings tar2(),0
  458.     
  459.         nclt = 0
  460.         FOR xt = 1 TO 8
  461.             FOR yt = 1 TO 8
  462.                 nclt = nclt + tar2(xt,yt)
  463.             NEXT yt
  464.         NEXT xt
  465.         nclt = nclt * (-cl)                
  466.         diff = nclt-ncl
  467.         END IF
  468.         
  469.         IF diff>ldiff THEN 
  470.             ldiff=diff 
  471.             urp = 0
  472.             ulp = 0
  473.             drp = 0
  474.         ELSE 
  475.             dlp = 0
  476.         END IF
  477.             END IF
  478.  
  479.     IF ldiff > 0 THEN eatf = 0 ELSE eatf = -1
  480.     ERASE tar,tar2,tar3,tar4
  481.  
  482.     testing = 0
  483.     skiptest:
  484.                                     
  485.     REM -------------------------- Check if eat-moves are possible 
  486.     IF x = 7 THEN ur = 0 : dr = 0
  487.     IF x = 2 THEN ul = 0 : dl = 0
  488.     IF y = 7 THEN dr = 0 : dl = 0
  489.     IF y = 2 THEN ur = 0 : ul = 0    
  490.     em = 0 : REM -- No Eat Move (Yet)
  491.     IF ur THEN p = a(x+2,y-2) : IF p = 0 THEN urp = 2 : em = -1
  492.     IF ul THEN p = a(x-2,y-2) : IF p = 0 THEN ulp = 2 : em = -1
  493.     IF dr THEN p = a(x+2,y+2) : IF p = 0 THEN drp = 2 : em = -1
  494.     IF dl THEN p = a(x-2,y+2) : IF p = 0 THEN dlp = 2 : em = -1
  495.  
  496.     REM -------------------------- If Eat if possible , no step-moves
  497.     IF em THEN
  498.         IF urp < 2 THEN urp = 0
  499.         IF ulp < 2 THEN ulp = 0
  500.         IF drp < 2 THEN drp = 0
  501.         IF dlp < 2 THEN dlp = 0
  502.     END IF        
  503.             
  504.     REM -------------------------- Select    B E S T   Move
  505.  
  506.     IF testing THEN GOTO skipSBME
  507.     testing = -1
  508.     
  509.     DIM tar(8,8),tar2(8,8),tar3(8,8),tar4(8,8)
  510.     FOR xt = 1 TO 8 : FOR yt = 1 TO 8
  511.         tar(xt,yt) = a(xt,yt)
  512.     NEXT yt : NEXT xt
  513.     
  514.     cl = a(x,y)/ABS(a(x,y))
  515.     ncl = 0
  516.     FOR xt = 1 TO 8
  517.         FOR yt = 1 TO 8
  518.             ncl = ncl + a(xt,yt)
  519.         NEXT yt
  520.     NEXT xt
  521.     ncl = ncl * cl
  522.     ldiff = -100
  523.  
  524.     IF urp = 2 THEN
  525.         cl = a(x,y)/ABS(a(x,y))
  526.         cl = cl * -1
  527.         SWAP tar(x,y),tar(x+2,y-2) 
  528.         tar(x+1,y-1) = 0
  529.         test  tar(),cl,tar4()
  530.         nclt = 0
  531.         FOR xt = 1 TO 8
  532.             FOR yt = 1 TO 8
  533.                 nclt = nclt + tar4(xt,yt)
  534.             NEXT yt
  535.         NEXT xt
  536.         nclt = nclt * (-cl)                
  537.         diff = nclt-ncl
  538.  
  539.         IF diff => 0 THEN
  540.         test tar4(),-cl,tar3()
  541.         test tar3(),cl,tar2()
  542.         makekings tar2(),0
  543.  
  544.         nclt = 0
  545.         FOR xt = 1 TO 8
  546.             FOR yt = 1 TO 8
  547.                 nclt = nclt + tar2(xt,yt)
  548.             NEXT yt
  549.         NEXT xt
  550.         nclt = nclt * (-cl)                
  551.         diff = nclt-ncl
  552.         END IF
  553.  
  554.         IF diff>ldiff THEN ldiff=diff
  555.     END IF
  556.  
  557.     FOR xt = 1 TO 8 : FOR yt = 1 TO 8
  558.         tar(xt,yt) = a(xt,yt)
  559.     NEXT yt : NEXT xt
  560.     IF ulp = 2 THEN
  561.         cl = a(x,y)/ABS(a(x,y))
  562.         cl = cl * -1
  563.         SWAP tar(x,y),tar(x-2,y-2) 
  564.         tar(x-1,y-1) = 0
  565.         test  tar(),cl,tar4()
  566.         nclt = 0
  567.         FOR xt = 1 TO 8
  568.             FOR yt = 1 TO 8
  569.                 nclt = nclt + tar4(xt,yt)
  570.             NEXT yt
  571.         NEXT xt
  572.         nclt = nclt * (-cl)                
  573.         diff = nclt-ncl
  574.  
  575.         IF diff => 0 THEN
  576.         test tar4(),-cl,tar3()
  577.         test tar3(),cl,tar2()
  578.         makekings tar2(),0
  579.  
  580.         nclt = 0
  581.         FOR xt = 1 TO 8
  582.             FOR yt = 1 TO 8
  583.                 nclt = nclt + tar2(xt,yt)
  584.             NEXT yt
  585.         NEXT xt
  586.         nclt = nclt * (-cl)                
  587.         diff = nclt-ncl
  588.         END IF
  589.  
  590.         IF diff>ldiff THEN 
  591.             ldiff=diff 
  592.             urp = 0
  593.         ELSE 
  594.             ulp = 0
  595.         END IF
  596.     END IF
  597.  
  598.     FOR xt = 1 TO 8 : FOR yt = 1 TO 8
  599.         tar(xt,yt) = a(xt,yt)
  600.     NEXT yt : NEXT xt
  601.     IF drp = 2 THEN
  602.         cl = a(x,y)/ABS(a(x,y))
  603.         cl = cl * -1
  604.         SWAP tar(x,y),tar(x+2,y+2) 
  605.         tar(x+1,y+1) = 0
  606.         test  tar(),cl,tar4()
  607.         nclt = 0
  608.         FOR xt = 1 TO 8
  609.             FOR yt = 1 TO 8
  610.                 nclt = nclt + tar4(xt,yt)
  611.             NEXT yt
  612.         NEXT xt
  613.         nclt = nclt * (-cl)                
  614.         diff = nclt-ncl
  615.  
  616.         IF diff => 0 THEN
  617.         test tar4(),-cl,tar3()
  618.         test tar3(),cl,tar2()
  619.         makekings tar2(),0
  620.  
  621.         nclt = 0
  622.         FOR xt = 1 TO 8
  623.             FOR yt = 1 TO 8
  624.                 nclt = nclt + tar2(xt,yt)
  625.             NEXT yt
  626.         NEXT xt
  627.         nclt = nclt * (-cl)                
  628.         diff = nclt-ncl
  629.         END IF
  630.  
  631.         IF diff>ldiff THEN 
  632.             ldiff=diff 
  633.             urp = 0
  634.             ulp = 0
  635.         ELSE 
  636.             drp = 0
  637.         END IF
  638.  
  639.     END IF
  640.  
  641.     FOR xt = 1 TO 8 : FOR yt = 1 TO 8
  642.         tar(xt,yt) = a(xt,yt)
  643.     NEXT yt : NEXT xt
  644.     IF dlp = 2 THEN
  645.         cl = a(x,y)/ABS(a(x,y))
  646.         cl = cl * -1
  647.         SWAP tar(x,y),tar(x-2,y+2) 
  648.         tar(x-1,y+1) = 0
  649.         test  tar(),cl,tar4()
  650.         nclt = 0
  651.         FOR xt = 1 TO 8
  652.             FOR yt = 1 TO 8
  653.                 nclt = nclt + tar4(xt,yt)
  654.             NEXT yt
  655.         NEXT xt
  656.         nclt = nclt * (-cl)                
  657.         diff = nclt-ncl
  658.  
  659.         IF diff => 0 THEN
  660.         test tar4(),-cl,tar3()
  661.         test tar3(),cl,tar2()
  662.         makekings tar2(),0
  663.  
  664.         nclt = 0
  665.         FOR xt = 1 TO 8
  666.             FOR yt = 1 TO 8
  667.                 nclt = nclt + tar2(xt,yt)
  668.             NEXT yt
  669.         NEXT xt
  670.         nclt = nclt * (-cl)                
  671.         diff = nclt-ncl
  672.         END IF
  673.  
  674.         IF diff>ldiff THEN 
  675.             ldiff=diff 
  676.             urp = 0
  677.             ulp = 0
  678.             drp = 0
  679.         ELSE 
  680.             dlp = 0
  681.         END IF
  682.     END IF
  683.     
  684.     IF em THEN
  685.         IF ldiff > 0 THEN eatf = 0 ELSE eatf = -1
  686.     END IF
  687.     
  688.     ERASE tar,tar2,tar3,tar4
  689.     testing = 0
  690.     skipSBME:
  691.  
  692.     xd = 0 : yd = 0 : mrp = 0
  693.     IF urp > mrp THEN xd =  1 : yd = -1 : mrp = urp
  694.     IF ulp > mrp THEN xd = -1 : yd = -1 : mrp = ulp
  695.     IF drp > mrp THEN xd =  1 : yd =  1 : mrp = drp
  696.     IF dlp > mrp THEN xd = -1 : yd =  1 : mrp = dlp
  697.    IF mrp = 2 THEN
  698.         xd = xd * 2 : yd = yd * 2
  699.     END IF
  700.     
  701.     REM -------------------------- Set Output Variables
  702.     x1 = x + xd
  703.     y1 = y + yd
  704.     flags = mrp
  705. END SUB    
  706.  
  707. REM ----------------------------------------- SCREEN UPDATE ROUTINE
  708.  
  709. SUB mark(xp,yp,x,y,xl,yl) STATIC
  710.         EXIT SUB
  711.         sx = (xl/8)*(xp-1)
  712.         ex = sx + xl/8
  713.         sy = (yl/8)*(yp-1)
  714.         ey = sy + yl/8
  715.         sx = sx + x
  716.         sy = sy + y
  717.         ex = ex + x
  718.         ey = ey + y
  719.         FOR n = 1 TO 3
  720.             FOR c = 0 TO 1
  721.                 LINE (sx+c,sy+c)-(ex-c,ey-c),3,b
  722.             NEXT c
  723.             FOR c = 0 TO 1
  724.                 LINE (sx+c,sy+c)-(ex-c,ey-c),2,b
  725.             NEXT c
  726.             FOR c = 0 TO 1
  727.                 LINE (sx+c,sy+c)-(ex-c,ey-c),1,b
  728.             NEXT c
  729.             FOR c = 0 TO 1
  730.                 LINE (sx+c,sy+c)-(ex-c,ey-c),0,b
  731.             NEXT c
  732.         NEXT n
  733. END SUB
  734.  
  735. SUB update(a(),x,y,xl,yl) STATIC
  736.     IF NOT(fgUD) THEN
  737.         DIM bb(8,8)
  738.         FOR xbb = 1 TO 8 : FOR ybb = 1 TO 8
  739.             bb(xbb,ybb) = 30
  740.         NEXT ybb : NEXT xbb 
  741.         fgUD = -1
  742.     END IF
  743.     rk=0:rp=0:bk=0:bp=0
  744.     FOR xp = 1 TO 8
  745.         FOR yp = 1 TO 8
  746.             IF a(xp,yp) = -1 THEN INCR rp
  747.             IF a(xp,yp) = -2 THEN INCR rk
  748.             IF a(xp,yp) = 1  THEN INCR bp
  749.             IF a(xp,yp) = 2  THEN INCR bk
  750.             
  751.             IF a(xp,yp) = bb(xp,yp) THEN GOTO skip1
  752.             bb(xp,yp) = a(xp,yp)
  753.             sx = (xl/8)*(xp-1)
  754.             ex = sx + xl/8
  755.             sy = (yl/8)*(yp-1)
  756.             ey = sy + yl/8
  757.             sx = sx + x
  758.             sy = sy + y
  759.             ex = ex + x
  760.             ey = ey + y
  761.             cl = ((xp+yp)/2) - INT((xp+yp)/2)
  762.             IF cl = 0 THEN
  763.                 colr = 0
  764.             ELSE
  765.                 colr = 1
  766.             END IF
  767.             LINE (sx,sy)-(ex,ey),colr,bf
  768.             IF a(xp,yp) < 0 THEN
  769.                 sx = sx + (xl/16)
  770.                 sy = sy + (yl/16)
  771.                 rd = SQR(((yl/20)^2)+((xl/20)^2))
  772.                 rd = rd / 1.3
  773.                 CIRCLE (sx,sy),rd,2,,,yl/xl
  774.                 PAINT (sx,sy),2
  775.                 IF a(xp,yp) = -2 THEN
  776.                     FOR xx = rd*4/5 TO rd
  777.                         CIRCLE (sx,sy),xx,1,,,yl/xl
  778.                     NEXT xx
  779.                 END IF
  780.             END IF
  781.             IF a(xp,yp) > 0 THEN
  782.                 sx = sx + (xl/16)
  783.                 sy = sy + (yl/16)
  784.                 rd = SQR(((yl/20)^2)+((xl/20)^2))
  785.                 rd = rd / 1.3
  786.                 CIRCLE (sx,sy),rd,3,,,yl/xl
  787.                 PAINT (sx,sy),3
  788.                 IF a(xp,yp) = 2 THEN
  789.                     FOR xx = rd*4/5 TO rd
  790.                         CIRCLE (sx,sy),xx,1,,,yl/xl
  791.                     NEXT xx
  792.                 END IF
  793.             END IF
  794.             skip1:
  795.         NEXT yp
  796.     NEXT xp
  797.     
  798.     sx = INT((x/8)+2)
  799.     sy = INT((yl*7/64)+(y/8)+2)
  800.     COLOR 0,1
  801.     LOCATE sy+0,sx+0 : PRINT "Cl K  P"
  802.     LOCATE sy+1,sx : PRINT "Rd";
  803.     LOCATE sy+1,sx+2 : PRINT rk;
  804.     LOCATE sy+1,sx+5 : PRINT rp;
  805.     LOCATE sy+2,sx : PRINT "Bl";
  806.     LOCATE sy+2,sx+2 : PRINT bk;
  807.     LOCATE sy+2,sx+5 : PRINT bp;
  808.     COLOR 1,0    
  809. END SUB         
  810.  
  811. SUB setpieces(a()) STATIC
  812.     FOR y = 1 TO 3
  813.         FOR x = 1 TO 8
  814.             checksquare x,y,a
  815.             IF a THEN a(x,y) = 1 ELSE a(x,y) =0
  816.         NEXT x
  817.     NEXT y
  818.     FOR y = 4 TO 5
  819.         FOR x = 1 TO 8
  820.             checksquare x,y,a
  821.             IF a THEN a(x,y) = 0 ELSE a(x,y) =0
  822.         NEXT x
  823.     NEXT y
  824.     FOR y = 6 TO 8
  825.         FOR x = 1 TO 8
  826.             checksquare x,y,a
  827.             IF a THEN a(x,y) = -1 ELSE a(x,y) =0
  828.         NEXT x
  829.     NEXT y
  830. END SUB
  831.  
  832. SUB scrlmsg STATIC
  833.     SHARED sye
  834.     SCROLL (0,sye+1)-(600,480),0,-2
  835.     SCROLL (0,sye+1)-(600,480),0,-2
  836.     SCROLL (0,sye+1)-(600,480),0,-2
  837.     SCROLL (0,sye+1)-(600,480),0,-3
  838.     IF INKEY$ <> "" THEN
  839.         LOCATE 58,70 : PRINT "PAUSE"
  840.         WHILE INKEY$ = "" : WEND
  841.         LOCATE 58,70 : PRINT "     "
  842.     END IF
  843. END SUB
  844.  
  845. SUB checksquare(xp,yp,a) STATIC
  846.             cl = ((xp+yp)/2) - INT((xp+yp)/2)
  847.             IF cl = 0 THEN
  848.                 a = -1
  849.             ELSE
  850.                 a = 0
  851.             END IF
  852. END SUB    
  853.  
  854.  
  855. REM --------------------------------------------------------------------
  856. REM ---- THIS IS THE OPPONENT THAT MUST BE WON ** WITH REGULARITY ** ---
  857. REM --------------------------------------------------------------------
  858.  
  859. SUB play2(a(),col,n()) STATIC
  860.     SHARED sxs,sys,sxe,sye,eatf
  861.     DIM movelist(600,3) : REM 1 : Start Square  2 : Dest Square  3 : Points
  862.     mlp = 0 : REM MoveListPointer (Reset)
  863.  
  864.     FOR xp = 1 TO 8
  865.         FOR yp = 1 TO 8
  866.             checksquare xp,yp,a
  867.             IF a THEN
  868.                 p = a(xp,yp)
  869.                 IF p<>0 THEN 
  870.                     pf= p/ABS(p)
  871.                 ELSE
  872.                     pf= 0
  873.                 END IF
  874.                 IF pf = col THEN
  875.                     INCR mlp
  876.                     movelist(mlp,1) = xp + ((yp-1)*8)
  877.                 END IF
  878.             END IF
  879.         NEXT yp
  880.     NEXT xp
  881.  
  882.     REM ----------------------------------- Get First Move
  883.     bflg = 0
  884.     LOCATE 57,1:PRINT "----------------------------------------------------------------------":scrlmsg
  885.     FOR xk1 = 1 TO mlp
  886.  
  887.         ps = movelist(xk1,1)
  888.         yp = INT((ps-1)/8)
  889.         xp = ps-(yp*8)
  890.         INCR yp
  891.  
  892.         flg1 = 0        
  893.         getmoves2 a(),xp,yp,xn,yn,flg1
  894.     
  895.         IF flg1 > bflg THEN
  896.             bflg = flg1
  897.             sx = xp
  898.             sy = yp
  899.             dx = xn
  900.             dy = yn
  901.             LOCATE 57,1:PRINT "CHK1",sx,sy,dx,dy :scrlmsg
  902.             unsafe = -1
  903.         END IF
  904.         IF flg1 >= bflg AND NOT(eatf) AND unsafe = -1
  905.             bflg = flg1
  906.             sx = xp
  907.             sy = yp
  908.             dx = xn
  909.             dy = yn
  910.             unsafe = 0
  911.             LOCATE 57,1:PRINT "SAFE",sx,sy,dx,dy :scrlmsg
  912.         END IF
  913.         IF flg1 = bflg AND (RND>0.7) AND NOT(eatf) THEN
  914.             bflg = flg1
  915.             sx = xp
  916.             sy = yp
  917.             dx = xn
  918.             dy = yn
  919.             unsafe = 0
  920.             LOCATE 57,1:PRINT "RAND",sx,sy,dx,dy :scrlmsg
  921.         END IF
  922.         
  923.     NEXT xk1    
  924.     
  925.     REM ------------------------------------ Execute the Move
  926.     FOR x = 1 TO 8
  927.         FOR y = 1 TO 8
  928.             n(x,y) = a(x,y)
  929.         NEXT y
  930.     NEXT x
  931.  
  932.     PALETTE 0,0,0,0
  933.     IF bflg = 0 THEN 
  934.         PALETTE 0,0,0,1
  935.     END IF
  936.     IF bflg < 0 THEN
  937.         PALETTE 0,1,0,0
  938.     END IF
  939.     
  940.     IF bflg > 0 THEN
  941.         mark sx,sy,sxs,sys,sxe,sye
  942.         mark dx,dy,sxs,sys,sxe,sye
  943.         SWAP n(sx,sy),n(dx,dy)        
  944.     END IF
  945.     IF bflg = 2 THEN
  946.         kx = ((dx-sx)/2)+sx        
  947.         ky = ((dy-sy)/2)+sy
  948.         n(kx,ky) = 0
  949.     END IF
  950.  
  951.     REM ------------------------------------- Second Eat Move    
  952.     IF bflg = 2 THEN
  953.         nxtmove3:
  954.         flg1 = 1
  955.         getmoves2 n(),dx,dy,nx,ny,flg1
  956.         IF flg1 = 2 THEN
  957.             mark nx,ny,sxs,sys,sxe,sye
  958.             SWAP n(nx,ny),n(dx,dy)        
  959.             kx = ((nx-dx)/2)+dx        
  960.             ky = ((ny-dy)/2)+dy
  961.             n(kx,ky) = 0
  962.             dx = nx : dy = ny
  963.             GOTO nxtmove3
  964.         END IF
  965.     END IF
  966.  
  967.     FOR x = 1 TO 8
  968.         FOR y = 1 TO 8
  969.             a(x,y) = n(x,y)
  970.         NEXT y
  971.     NEXT x
  972.         
  973.     ERASE movelist
  974. END SUB
  975.  
  976.  
  977. SUB getmoves2(a(),x,y,x1,y1,flags) STATIC
  978.     REM -- FLAGS = 1 on Entry := Non-Eat moves discarded
  979.     
  980.     LOCAL ur,dr,ul,dl,p
  981.     LOCAL urp,drp,ulp,dlp
  982.     SHARED eatf
  983.     ur = -1 : dr = -1 : ul = -1 : dl = -1 : REM UpRight ...
  984.     p = a(x,y)
  985.     
  986.     REM ------------------------- Eliminate Non-King Non-Moves
  987.     IF ABS(p) = 1 THEN
  988.         IF p = 1 THEN ur = 0 : ul = 0
  989.         IF p = -1 THEN dr= 0 : dl = 0
  990.     END IF 
  991.     
  992.     REM ------------------------- Board Edge Check
  993.     IF x = 8 THEN ur = 0 : dr = 0
  994.     IF x = 1 THEN ul = 0 : dl = 0
  995.     IF y = 8 THEN dr = 0 : dl = 0
  996.     IF y = 1 THEN ur = 0 : ul = 0    
  997.  
  998.     REM ------------------------- Check if friendly pieces in way    
  999.     IF ur THEN p = a(x+1,y-1) : IF p/a(x,y) > 0 THEN ur = 0
  1000.     IF ul THEN p = a(x-1,y-1) : IF p/a(x,y) > 0 THEN ul = 0
  1001.     IF dr THEN p = a(x+1,y+1) : IF p/a(x,y) > 0 THEN dr = 0
  1002.     IF dl THEN p = a(x-1,y+1) : IF p/a(x,y) > 0 THEN dl = 0
  1003.         
  1004.     REM -------------------------- Eliminate non-eat moves
  1005.     IF flags = 1 THEN
  1006.         IF ur THEN p = a(x+1,y-1) : IF p = 0 THEN ur = 0
  1007.         IF ul THEN p = a(x-1,y-1) : IF p = 0 THEN ul = 0
  1008.         IF dr THEN p = a(x+1,y+1) : IF p = 0 THEN dr = 0
  1009.         IF dl THEN p = a(x-1,y+1) : IF p = 0 THEN dl = 0
  1010.     END IF
  1011.  
  1012.     REM -------------------------- Initialise Move Pointers
  1013.     urp = 0 : ulp = 0 : drp = 0 : dlp = 0
  1014.     
  1015.     REM -------------------------- Check if step-moves are possible
  1016.     IF ur THEN p = a(x+1,y-1) : IF p = 0 THEN urp = 1 : ur = 0
  1017.     IF ul THEN p = a(x-1,y-1) : IF p = 0 THEN ulp = 1 : ul = 0
  1018.     IF dr THEN p = a(x+1,y+1) : IF p = 0 THEN drp = 1 : dr = 0
  1019.     IF dl THEN p = a(x-1,y+1) : IF p = 0 THEN dlp = 1 : dl = 0
  1020.  
  1021.     REM -------------------------- Select Best step-Move ..
  1022.     IF testing THEN GOTO skipTEST2
  1023.     testing = -1
  1024.     DIM tar(8,8),tar2(8,8)
  1025.     FOR xt = 1 TO 8 : FOR yt = 1 TO 8
  1026.         tar(xt,yt) = a(xt,yt)
  1027.     NEXT yt : NEXT xt
  1028.     
  1029.     cl = a(x,y)/ABS(a(x,y))
  1030.     ncl = 0
  1031.     FOR xt = 1 TO 8 : FOR yt = 1 TO 8
  1032.         IF a(xt,yt) <> 0 THEN
  1033.             IF a(xt,yt)/ABS(a(xt,yt)) = cl THEN
  1034.                 ncl = ncl + a(xt,yt)
  1035.             END IF
  1036.         END IF
  1037.     NEXT yt : NEXT xt
  1038.     ncl = ABS(ncl)
  1039.     ldiff = 10
  1040.  
  1041.     IF urp = 1 THEN
  1042.         cl = a(x,y)/ABS(a(x,y))
  1043.         cl = cl * -1
  1044.         SWAP tar(x,y),tar(x+1,y-1) 
  1045.         test22 tar(),cl,tar2()
  1046.         nclt = 0
  1047.         FOR xt = 1 TO 8 : FOR yt = 1 TO 8
  1048.             IF tar2(xt,yt) <> 0 THEN
  1049.             IF tar2(xt,yt)/ABS(tar2(xt,yt)) = -cl THEN
  1050.                 nclt = nclt + tar2(xt,yt)
  1051.             END IF
  1052.             END IF
  1053.         NEXT yt : NEXT xt
  1054.         nclt = ABS(nclt)
  1055.         diff = ncl-nclt
  1056.         IF diff<ldiff THEN ldiff=diff
  1057.     END IF
  1058.  
  1059.     FOR xt = 1 TO 8 : FOR yt = 1 TO 8
  1060.         tar(xt,yt) = a(xt,yt)
  1061.     NEXT yt : NEXT xt
  1062.     IF ulp = 1 THEN
  1063.         cl = a(x,y)/ABS(a(x,y))
  1064.         cl = cl * -1
  1065.         SWAP tar(x,y),tar(x-1,y-1) 
  1066.         test22 tar(),cl,tar2()
  1067.         nclt = 0
  1068.         FOR xt = 1 TO 8 : FOR yt = 1 TO 8
  1069.             IF tar2(xt,yt) <> 0 THEN
  1070.             IF tar2(xt,yt)/ABS(tar2(xt,yt)) = -cl THEN
  1071.                 nclt = nclt + tar2(xt,yt)
  1072.             END IF
  1073.             END IF
  1074.         NEXT yt : NEXT xt
  1075.         nclt = ABS(nclt)
  1076.         diff = ncl-nclt
  1077.         IF diff<ldiff THEN 
  1078.             ldiff=diff 
  1079.             urp = 0
  1080.         ELSE 
  1081.             ulp = 0
  1082.         END IF
  1083.     END IF
  1084.  
  1085.     FOR xt = 1 TO 8 : FOR yt = 1 TO 8
  1086.         tar(xt,yt) = a(xt,yt)
  1087.     NEXT yt : NEXT xt
  1088.     IF drp = 1 THEN
  1089.         cl = a(x,y)/ABS(a(x,y))
  1090.         cl = cl * -1
  1091.         SWAP tar(x,y),tar(x+1,y+1) 
  1092.         test22 tar(),cl,tar2()
  1093.         nclt = 0
  1094.         FOR xt = 1 TO 8 : FOR yt = 1 TO 8
  1095.             IF tar2(xt,yt) <> 0 THEN
  1096.             IF tar2(xt,yt)/ABS(tar2(xt,yt)) = -cl THEN
  1097.                 nclt = nclt + tar2(xt,yt)
  1098.             END IF
  1099.             END IF
  1100.         NEXT yt : NEXT xt
  1101.         nclt = ABS(nclt)
  1102.         diff = ncl-nclt
  1103.         IF diff<ldiff THEN 
  1104.             ldiff=diff 
  1105.             urp = 0
  1106.             ulp = 0
  1107.         ELSE 
  1108.             drp = 0
  1109.         END IF
  1110.  
  1111.     END IF
  1112.  
  1113.     FOR xt = 1 TO 8 : FOR yt = 1 TO 8
  1114.         tar(xt,yt) = a(xt,yt)
  1115.     NEXT yt : NEXT xt
  1116.     IF dlp = 1 THEN
  1117.         cl = a(x,y)/ABS(a(x,y))
  1118.         cl = cl * -1
  1119.         SWAP tar(x,y),tar(x-1,y+1) 
  1120.         test22 tar(),cl,tar2()
  1121.         nclt = 0
  1122.         FOR xt = 1 TO 8 : FOR yt = 1 TO 8
  1123.             IF tar2(xt,yt) <> 0 THEN
  1124.             IF tar2(xt,yt)/ABS(tar2(xt,yt)) = -cl THEN
  1125.                 nclt = nclt + tar2(xt,yt)
  1126.             END IF
  1127.             END IF
  1128.         NEXT yt : NEXT xt
  1129.         nclt = ABS(nclt)
  1130.         diff = ncl-nclt
  1131.         IF diff<ldiff THEN 
  1132.             ldiff=diff 
  1133.             urp = 0
  1134.             ulp = 0
  1135.             drp = 0
  1136.         ELSE 
  1137.             dlp = 0
  1138.         END IF
  1139.     END IF
  1140.  
  1141.     IF ldiff = 0 THEN eatf = 0 ELSE eatf = -1
  1142.     IF ldiff < 0 THEN PALETTE 0,1,0,0
  1143.     ERASE tar,tar2
  1144.  
  1145.     testing = 0
  1146.     skiptest2:
  1147.                                     
  1148.     REM -------------------------- Check if eat-moves are possible 
  1149.     IF x = 7 THEN ur = 0 : dr = 0
  1150.     IF x = 2 THEN ul = 0 : dl = 0
  1151.     IF y = 7 THEN dr = 0 : dl = 0
  1152.     IF y = 2 THEN ur = 0 : ul = 0    
  1153.     em = 0 : REM -- No Eat Move (Yet)
  1154.     IF ur THEN p = a(x+2,y-2) : IF p = 0 THEN urp = 2 : em = -1
  1155.     IF ul THEN p = a(x-2,y-2) : IF p = 0 THEN ulp = 2 : em = -1
  1156.     IF dr THEN p = a(x+2,y+2) : IF p = 0 THEN drp = 2 : em = -1
  1157.     IF dl THEN p = a(x-2,y+2) : IF p = 0 THEN dlp = 2 : em = -1
  1158.  
  1159.     REM -------------------------- If Eat if possible , no step-moves
  1160.     IF em THEN
  1161.         IF urp < 2 THEN urp = 0
  1162.         IF ulp < 2 THEN ulp = 0
  1163.         IF drp < 2 THEN drp = 0
  1164.         IF dlp < 2 THEN dlp = 0
  1165.     END IF        
  1166.             
  1167.     REM -------------------------- Select    B E S T   Move
  1168.  
  1169.     IF testing THEN GOTO skipSBME2
  1170.     testing = -1
  1171.     
  1172.     DIM tar(8,8),tar2(8,8)
  1173.     FOR xt = 1 TO 8 : FOR yt = 1 TO 8
  1174.         tar(xt,yt) = a(xt,yt)
  1175.     NEXT yt : NEXT xt
  1176.     
  1177.     cl = a(x,y)/ABS(a(x,y))
  1178.     ncl = 0
  1179.     FOR xt = 1 TO 8 : FOR yt = 1 TO 8
  1180.         IF a(xt,yt) <> 0 THEN
  1181.             IF a(xt,yt)/ABS(a(xt,yt)) = cl THEN
  1182.                 ncl = ncl + a(xt,yt)
  1183.             END IF
  1184.         END IF
  1185.     NEXT yt : NEXT xt
  1186.     ncl = ABS(ncl)
  1187.     ldiff = 1000
  1188.  
  1189.     IF urp = 2 THEN
  1190.         cl = a(x,y)/ABS(a(x,y))
  1191.         cl = cl * -1
  1192.         SWAP tar(x,y),tar(x+2,y-2) 
  1193.         tar(x+1,y-1) = 0
  1194.         test22 tar(),cl,tar2()
  1195.         nclt = 0
  1196.         FOR xt = 1 TO 8 : FOR yt = 1 TO 8
  1197.             IF tar2(xt,yt) <> 0 THEN
  1198.             IF tar2(xt,yt)/ABS(tar2(xt,yt)) = -cl THEN
  1199.                 nclt = nclt + tar2(xt,yt)
  1200.             END IF
  1201.             END IF
  1202.         NEXT yt : NEXT xt
  1203.         nclt = ABS(nclt)
  1204.         diff = ncl-nclt
  1205.         IF diff<ldiff THEN ldiff=diff
  1206.     END IF
  1207.  
  1208.     FOR xt = 1 TO 8 : FOR yt = 1 TO 8
  1209.         tar(xt,yt) = a(xt,yt)
  1210.     NEXT yt : NEXT xt
  1211.     IF ulp = 2 THEN
  1212.         cl = a(x,y)/ABS(a(x,y))
  1213.         cl = cl * -1
  1214.         SWAP tar(x,y),tar(x-2,y-2) 
  1215.         tar(x-1,y-1) = 0
  1216.         test22 tar(),cl,tar2()
  1217.         nclt = 0
  1218.         FOR xt = 1 TO 8 : FOR yt = 1 TO 8
  1219.             IF tar2(xt,yt) <> 0 THEN
  1220.             IF tar2(xt,yt)/ABS(tar2(xt,yt)) = -cl THEN
  1221.                 nclt = nclt + tar2(xt,yt)
  1222.             END IF
  1223.             END IF
  1224.         NEXT yt : NEXT xt
  1225.         nclt = ABS(nclt)
  1226.         diff = ncl-nclt
  1227.         IF diff<ldiff THEN 
  1228.             ldiff=diff 
  1229.             urp = 0
  1230.         ELSE 
  1231.             ulp = 0
  1232.         END IF
  1233.     END IF
  1234.  
  1235.     FOR xt = 1 TO 8 : FOR yt = 1 TO 8
  1236.         tar(xt,yt) = a(xt,yt)
  1237.     NEXT yt : NEXT xt
  1238.     IF drp = 2 THEN
  1239.         cl = a(x,y)/ABS(a(x,y))
  1240.         cl = cl * -1
  1241.         SWAP tar(x,y),tar(x+2,y+2) 
  1242.         tar(x+1,y+1) = 0
  1243.         test22 tar(),cl,tar2()
  1244.         nclt = 0
  1245.         FOR xt = 1 TO 8 : FOR yt = 1 TO 8
  1246.             IF tar2(xt,yt) <> 0 THEN
  1247.             IF tar2(xt,yt)/ABS(tar2(xt,yt)) = -cl THEN
  1248.                 nclt = nclt + tar2(xt,yt)
  1249.             END IF
  1250.             END IF
  1251.         NEXT yt : NEXT xt
  1252.         nclt = ABS(nclt)
  1253.         diff = ncl-nclt
  1254.         IF diff<ldiff THEN 
  1255.             ldiff=diff 
  1256.             urp = 0
  1257.             ulp = 0
  1258.         ELSE 
  1259.             drp = 0
  1260.         END IF
  1261.  
  1262.     END IF
  1263.  
  1264.     FOR xt = 1 TO 8 : FOR yt = 1 TO 8
  1265.         tar(xt,yt) = a(xt,yt)
  1266.     NEXT yt : NEXT xt
  1267.     IF dlp = 2 THEN
  1268.         cl = a(x,y)/ABS(a(x,y))
  1269.         cl = cl * -1
  1270.         SWAP tar(x,y),tar(x-2,y+2) 
  1271.         tar(x-1,y+1) = 0
  1272.         test22 tar(),cl,tar2()
  1273.         nclt = 0
  1274.         FOR xt = 1 TO 8 : FOR yt = 1 TO 8
  1275.             IF tar2(xt,yt) <> 0 THEN
  1276.             IF tar2(xt,yt)/ABS(tar2(xt,yt)) = -cl THEN
  1277.                 nclt = nclt + tar2(xt,yt)
  1278.             END IF
  1279.             END IF
  1280.         NEXT yt : NEXT xt
  1281.         nclt = ABS(nclt)
  1282.         diff = ncl-nclt
  1283.         IF diff<ldiff THEN 
  1284.             ldiff=diff 
  1285.             urp = 0
  1286.             ulp = 0
  1287.             drp = 0
  1288.         ELSE 
  1289.             dlp = 0
  1290.         END IF
  1291.     END IF
  1292.  
  1293.     IF em THEN
  1294.         IF ldiff = 0 THEN eatf = 0 ELSE eatf = -1
  1295.         IF ldiff < 0 THEN PALETTE 0,1,0,0
  1296.     END IF
  1297.     ERASE tar,tar2
  1298.     testing = 0
  1299.     skipSBME2:
  1300.  
  1301.     xd = 0 : yd = 0 : mrp = 0
  1302.     IF urp > mrp THEN xd =  1 : yd = -1 : mrp = urp
  1303.     IF ulp > mrp THEN xd = -1 : yd = -1 : mrp = ulp
  1304.     IF drp > mrp THEN xd =  1 : yd =  1 : mrp = drp
  1305.     IF dlp > mrp THEN xd = -1 : yd =  1 : mrp = dlp
  1306.    IF mrp = 2 THEN
  1307.         xd = xd * 2 : yd = yd * 2
  1308.     END IF
  1309.     
  1310.     REM -------------------------- Set Output Variables
  1311.     x1 = x + xd
  1312.     y1 = y + yd
  1313.     flags = mrp
  1314. END SUB    
  1315.  
  1316. SUB test22(a(),col,n()) STATIC
  1317.     SHARED sxs,sys,sxe,sye
  1318.     DIM movelist22(600,3) : REM 1 : Start Square  2 : Dest Square  3 : Points
  1319.     mlp2 = 0 : REM movelist22Pointer (Reset)
  1320.  
  1321.     FOR xp = 1 TO 8
  1322.         FOR yp = 1 TO 8
  1323.             checksquare xp,yp,a
  1324.             IF a THEN
  1325.                 p = a(xp,yp)
  1326.                 IF p<>0 THEN 
  1327.                     pf= p/ABS(p)
  1328.                 ELSE
  1329.                     pf= 0
  1330.                 END IF
  1331.                 IF pf = col THEN
  1332.                     INCR mlp2
  1333.                     movelist22(mlp2,1) = xp + ((yp-1)*8)
  1334.                 END IF
  1335.             END IF
  1336.         NEXT yp
  1337.     NEXT xp
  1338.  
  1339.     REM ----------------------------------- Get First Move
  1340.     bflt = 0
  1341.     FOR xk1 = 1 TO mlp2
  1342.  
  1343.         ps = movelist22(xk1,1)
  1344.         yp = INT((ps-1)/8)
  1345.         xp = ps-(yp*8)
  1346.         INCR yp
  1347.  
  1348.         flg1 = 0        
  1349.         getmoves2 a(),xp,yp,xn,yn,flg1
  1350.     
  1351.         IF flg1 > bflt THEN
  1352.             bflt = flg1
  1353.             sx = xp
  1354.             sy = yp
  1355.             dx = xn
  1356.             dy = yn
  1357.         END IF
  1358.         
  1359.     NEXT xk1    
  1360.     
  1361.     REM ------------------------------------ Execute the Move
  1362.     FOR x = 1 TO 8
  1363.         FOR y = 1 TO 8
  1364.             n(x,y) = a(x,y)
  1365.         NEXT y
  1366.     NEXT x
  1367.  
  1368.     PALETTE 0,0,0,0
  1369.     IF bflt = 0 THEN 
  1370.         PALETTE 0,0,0,1
  1371.     END IF
  1372.     IF bflt < 0 THEN
  1373.         PALETTE 0,1,0,0
  1374.     END IF
  1375.     
  1376.     IF bflt > 0 THEN
  1377.         mark sx,sy,sxs,sys,sxe,sye
  1378.         mark dx,dy,sxs,sys,sxe,sye
  1379.         SWAP n(sx,sy),n(dx,dy)        
  1380.     END IF
  1381.     IF bflt = 2 THEN
  1382.         kx = ((dx-sx)/2)+sx        
  1383.         ky = ((dy-sy)/2)+sy
  1384.         n(kx,ky) = 0
  1385.     END IF
  1386.  
  1387.     REM ------------------------------------- Second Eat Move    
  1388.     IF bflt = 2 THEN
  1389.         nxtmove22:
  1390.         flg1 = 1
  1391.         getmoves2 n(),dx,dy,nx,ny,flg1
  1392.         IF flg1 = 2 THEN
  1393.             mark nx,ny,sxs,sys,sxe,sye
  1394.             SWAP n(nx,ny),n(dx,dy)        
  1395.             kx = ((nx-dx)/2)+dx        
  1396.             ky = ((ny-dy)/2)+dy
  1397.             n(kx,ky) = 0
  1398.             dx = nx : dy = ny
  1399.             GOTO nxtmove22
  1400.         END IF
  1401.     END IF
  1402.  
  1403.     FOR x = 1 TO 8
  1404.         FOR y = 1 TO 8
  1405.             a(x,y) = n(x,y)
  1406.         NEXT y
  1407.     NEXT x
  1408.         
  1409.     ERASE movelist22
  1410. END SUB
  1411.  
  1412.